SuperHack/SuperHack CD.bin/CODING/DELPHI/D_RAS.ZIP/TESTFORM.PAS

Pascal/Delphi Source File | 1996-09-27 | 10.1 KB | 361 lines

unit TestForm;

// Remote Access API test program
// by Davide Moretti <[e-mail]>
//
// Play with it! :-)

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, Ras,
  StdCtrls, ExtCtrls, ComCtrls;

type
  TfrmTest = class(TForm)
    lstEntries: TListBox;
    btnGetEntries: TButton;
    btnCreateEntry: TButton;
    btnEditEntry: TButton;
    grpSelectedEntry: TGroupBox;
    btnGetParams: TButton;
    btnDialEntry: TButton;
    lblUserName: TLabel;
    lblPassword: TLabel;
    txtUserName: TEdit;
    txtPassword: TEdit;
    btnHangup: TButton;
    optDialMode: TRadioGroup;
    lblAsync: TLabel;
    lblStatus: TLabel;
    btnActiveConn: TButton;
    lvConnections: TListView;
    btnSetParams: TButton;
    txtCopyright: TMemo;
    procedure btnGetEntriesClick(Sender: TObject);
    procedure btnCreateEntryClick(Sender: TObject);
    procedure btnEditEntryClick(Sender: TObject);
    procedure btnDialEntryClick(Sender: TObject);
    procedure btnHangupClick(Sender: TObject);
    procedure btnGetParamsClick(Sender: TObject);
    procedure lstEntriesClick(Sender: TObject);
    procedure txtUserNameChange(Sender: TObject);
    procedure btnActiveConnClick(Sender: TObject);
    procedure btnSetParamsClick(Sender: TObject);
  private
    { Private declarations }
    dialparams: TRasDialParams;
  public
    { Public declarations }
  end;

var
  frmTest: TfrmTest;

implementation

{$R *.DFM}

function StatusString(state: TRasConnState; error: Longint): String;
  var
    c: Array[0..100] of Char;
    s: String;
  begin
  if error <> 0 then
    begin
    RasGetErrorString(error, c, 100);
    Result := c;
    end
  else
    begin
    s := '';
    case State of
      RASCS_OpenPort:
        s := 'Opening port';
      RASCS_PortOpened:
        s := 'Port opened';
      RASCS_ConnectDevice:
        s := 'Connecting device';
      RASCS_DeviceConnected:
        s := 'Device connected';
      RASCS_AllDevicesConnected:
        s := 'All devices connected';
      RASCS_Authenticate:
        s := 'Start authenticating';
      RASCS_AuthNotify:
        s := 'Authentication: notify';
      RASCS_AuthRetry:
        s := 'Authentication: retry';
      RASCS_AuthCallback:
        s := 'Authentication: callback';
      RASCS_AuthChangePassword:
        s := 'Authentication: change password';
      RASCS_AuthProject:
        s := 'Authentication: projecting';
      RASCS_AuthLinkSpeed:
        s := 'Authentication: link speed';
      RASCS_AuthAck:
        s := 'Authentication: acknowledge';
      RASCS_ReAuthenticate:
        s := 'Authentication: reauthenticate';
      RASCS_Authenticated:
        s := 'Authenticated';
      RASCS_PrepareForCallback:
        s := 'Preparing for callback';
      RASCS_WaitForModemReset:
        s := 'Waiting for modem reset';
      RASCS_WaitForCallback:
        s := 'Waiting for callback';
      RASCS_Projected:
        s := 'Projected';
      RASCS_StartAuthentication:
        s := 'Start authentication';
      RASCS_CallbackComplete:
        s := 'Callback complete';
      RASCS_LogonNetwork:
        s := 'Logging on network';

      RASCS_Interactive:
        s := 'Interactive';
      RASCS_RetryAuthentication:
        s := 'Retry Authentication';
      RASCS_CallbackSetByCaller:
        s := 'Callback set by caller';
      RASCS_PasswordExpired:
        s := 'Password expired';

      RASCS_Connected:
        s := 'Connected';
      RASCS_Disconnected:
        s := 'Disconnected';
      end;
    Result := s;
    end;
  end;

// Callback RAS function
procedure RasCallback(msg: Integer; state: TRasConnState;
    error: Longint); stdcall
  begin
  if error = 0 then
    frmTest.lblStatus.Font.Color := clBlue
  else
    frmTest.lblStatus.Font.Color := clRed;
  frmTest.lblStatus.Caption := StatusString(state, error);
  frmTest.btnActiveConn.Click;
  end;

procedure TfrmTest.btnGetEntriesClick(Sender: TObject);
  var
    bufsize: Longint;
    numEntries: Longint;
    entries: Array[1..100] of TRasEntryName;
    x: Integer;
  begin
  btnEditEntry.Enabled := False;
  btnGetParams.Enabled := False;
  txtUserName.Text := '';
  txtPassword.Text := '';
  lstEntries.Items.Clear;
  entries[1].dwSize := SizeOf(TRasEntryName);
  bufsize := SizeOf(TRasEntryName) * 100;
  if RasEnumEntries(nil, nil, @entries[1], bufsize, numEntries) = 0 then
    begin
    if numEntries > 0 then
      begin
      for x := 1 to numEntries do
        lstEntries.Items.Add(entries[x].szEntryName);
      lstEntries.ItemIndex := 0;
      lstEntriesClick(lstEntries);
      btnEditEntry.Enabled := True;
      btnGetParams.Enabled := True;
      end;
    end
  else
    ShowMessage('RasEnumEntries failed.');
  end;

procedure TfrmTest.btnCreateEntryClick(Sender: TObject);
  begin
  if RasCreatePhonebookEntry(Handle, nil) = 0 then
    btnGetEntries.Click
  else
    ShowMessage('RasCreatePhonebookEntry failed.');
  end;

procedure TfrmTest.btnEditEntryClick(Sender: TObject);
  begin
  if RasEditPhonebookEntry(Handle, nil,
      PChar(lstEntries.Items[lstEntries.ItemIndex])) <> 0 then
    ShowMessage('RasEditPhonebookEntry failed.');
  end;

procedure TfrmTest.btnDialEntryClick(Sender: TObject);
  var
    r: integer;
    c: Array[0..100] of Char;
    hRas: THRasConn;
  begin
  Screen.Cursor := crHourglass;
  FillChar(dialparams, SizeOf(TRasDialParams), 0);
  with dialparams do
    begin
    dwSize := Sizeof(TRasDialParams);
    StrPCopy(szEntryName, lstEntries.Items[lstEntries.ItemIndex]);
    StrPCopy(szUserName, txtUserName.Text);
    StrPCopy(szPassword, txtPassword.Text);
    // You can override phone number here...
    // StrPCopy(szPhoneNumber, 'xxxxxx');
    end;
  hRas := 0;
  if optDialMode.ItemIndex = 0 then
    // Sync dial
    begin
    lblStatus.ParentFont := True;
    lblStatus.Caption := 'Dialing...';
    lblStatus.Refresh;
    r := RasDial(nil, nil, dialparams, 0, nil, hRas);
    if r = 0 then
      begin
      lblStatus.Caption := 'Connected';
      btnActiveConn.Click;
      end
    else
      begin
      lblStatus.Caption := 'Error';
      if hRas <> 0 then
        RasHangUp(hRas);
      end;
    end
   else
    // Async dial
    r := RasDial(nil,   // This field is ignored in Windows95
        nil,  // Phonebook: use default (not used on Win95)
        dialparams,
        0, // use callback function of type RASDIALFUNC
        @RasCallback,   // callback function
        hRas);
  if r <> 0 then
    begin
    RasGetErrorString(r, c, 100);
    ShowMessage('RasDial failed: ' + c);
    end;
  Screen.Cursor := crDefault;
  end;

procedure TfrmTest.btnHangupClick(Sender: TObject);
  var
    hRas: THRasConn;
  begin
  hRas := Longint(lvConnections.ItemFocused.Data);
  if RasHangUp(hRas) = 0 then
    begin
    Sleep(1000);  // wait 1 second
    btnActiveConn.Click;
    end
  else
    ShowMessage('RasHangUp failed.');
  end;

procedure TfrmTest.btnGetParamsClick(Sender: TObject);
  var
    fp: LongBool;
    r: Longint;
    c: Array[0..100] of Char;
  begin
  FillChar(dialparams, SizeOf(TRasDialParams), 0);
  with dialparams do
    begin
    dwSize := Sizeof(TRasDialParams);
    StrPCopy(szEntryName, lstEntries.Items[lstEntries.ItemIndex]);
    end;
  r := RasGetEntryDialParams(nil, dialparams, fp);
  if r = 0 then
    with dialparams do
      begin
      txtUserName.Text := szUserName;
      if fp then
        txtPassword.Text := szPassword;
      end
  else
    begin
    RasGetErrorString(r, c, 100);
    ShowMessage('RasGetEntryDialParams failed: ' + c);
    end;
  end;

procedure TfrmTest.lstEntriesClick(Sender: TObject);
  begin
  grpSelectedEntry.Caption := 'Selected entry: ' +
      lstEntries.Items[lstEntries.ItemIndex];
  end;

procedure TfrmTest.txtUserNameChange(Sender: TObject);
  begin
  if lstEntries.ItemIndex = -1 then
    Exit;
  btnDialEntry.Enabled := (txtUserName.Text <> '');
  btnSetParams.Enabled := btnDialEntry.Enabled;
  end;

procedure TfrmTest.btnActiveConnClick(Sender: TObject);
  var
    bufsize: Longint;
    numEntries: Longint;
    x: Integer;
    entries: Array[1..100] of TRasConn;
    stat: TRasConnStatus;
  begin
  entries[1].dwSize := SizeOf(TRasConn);
  bufsize := SizeOf(TRasConn) * 100;
  btnHangup.Enabled := False;
  lvConnections.Items.Clear;
  FillChar(stat, Sizeof(TRasConnStatus), 0);
  stat.dwSize := Sizeof(TRasConnStatus);
  if RasEnumConnections(@entries[1], bufsize, numEntries) = 0 then
    begin
    if numEntries > 0 then
      begin
      for x := 1 to numEntries do
        with lvConnections.Items.Add, entries[x] do
          begin
          Data := Pointer(hrasconn);
          Caption := szEntryName;
          SubItems.Add(szDeviceType);
          SubItems.Add(szDeviceName);
          RasGetConnectStatus(hrasconn, stat);
          SubItems.Add(StatusString(stat.rasconnstate, stat.dwError));
          end;
      lvConnections.ItemFocused := lvConnections.Items[0];
      btnHangup.Enabled := True;
      end;
    end
  else
    ShowMessage('RasEnumConnections failed.');
  end;

procedure TfrmTest.btnSetParamsClick(Sender: TObject);
  begin
  if Application.MessageBox(PChar('Save parameters for entry ' +
      lstEntries.Items[lstEntries.ItemIndex] + '?'), PChar(Caption),
      MB_ICONWARNING or MB_YESNO) = IDYES then
    begin
    with dialparams do
      begin
      // Note: as stated in WIN32.HLP, the szPhoneNumber cannot be changed by
      // this function. The only way to change it (as far as I know) is to use
      // RasEditPhoneBookEntry and change it manually. Or it's possible to
      // specify szPhoneNumber for the RasDial function.
      dwSize := Sizeof(TRasDialParams);
      StrPCopy(szEntryName, lstEntries.Items[lstEntries.ItemIndex]);
      StrPCopy(szUserName, txtUserName.Text);
      StrPCopy(szPassword, txtPassword.Text);
      StrPCopy(szPhoneNumber, '111');
      end;
    if RasSetEntryDialParams(nil, dialparams, False) <> 0 then
      ShowMessage ('RasSetEntryDialParams failed.');
    end;
  end;

end.